home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / autodial.arc / AUTODIAL.BAS
Encoding:
BASIC Source File  |  1985-08-25  |  7.8 KB  |  169 lines
  1. 1 REM *** AUTODIALER ***
  2. 2 '   BY BILL SCHMITT
  3. 3 ' FOR USE WITH SMARTMODEM.
  4. 4 '******* IF ANY FAULTS ARE FOUND, LEAVE ME A MSG ON THIS BBS.
  5. 10 COLOR 7:KEY OFF:CLS
  6. 20 DIM A$(100),NUM$(100)
  7. 30 FOR X=1 TO 5:READ M$:MENU$=MENU$+M$+CHR$(13):NEXT
  8. 31 FOR X=1 TO 3:READ M$:MEN1$=MEN1$+M$+CHR$(13):NEXT
  9. 40 DATA"Do you wish to:   1) Edit numbers in memory."
  10. 50 DATA "                  2) Load numbers from disk."
  11. 60 DATA "                  3) Store numbers to disk."
  12. 70 DATA "                  4) Dial a number."
  13. 80 DATA "                  5) List all numbers in memory."
  14. 90 DATA "                  6) Run another program."
  15. 100 DATA "                  7) Switch to 'dumb' terminal"
  16. 110 DATA "                  8) Quit."
  17. 120 KEY OFF
  18. 130 CLS
  19. 140 PRINT "                  WELCOME TO AUTO-DIAL              "
  20. 150 PRINT:PRINT
  21. 160 FOR X=1 TO 500:NEXT
  22. 170 PRINT "There are no numbers in memory..."
  23. 180 FOR X=1 TO 500:NEXT
  24. 190 IF TT=1 THEN PRINT "MENU"
  25. 200 C=CSRLIN:LOCATE 25,1:PRINT SPC(79):LOCATE C,1,0
  26. 210 ON ERROR GOTO 0:PRINT MENU$;MEN1$
  27. 220 LOCATE ,21,1 :TT=1
  28. 230 J$=INKEY$:J=VAL(J$):IF J<1 OR J>8 THEN 230
  29. 240 ON J GOTO 300,1320,1200,1020,810,280,260,270
  30. 250 PRINT :GOTO 190
  31. 260 ON ERROR GOTO 0:RUN"acc.bas"
  32. 270 CLOSE:CLS:KEY ON:ON ERROR GOTO 0:SYSTEM:END
  33. 280 CLS:GOSUB 1500:PRINT:PRINT"DIRECTORY":FILES:PRINT:PRINT"Which basic program do you wish to run?";:GOSUB 1520:IF K$="" THEN 190 ELSE ON ERROR GOTO 290:K$=LEFT(K$,8)+".bas":RUN K$
  34. 290 PRINT:RESUME 280
  35. 300 CLS:LOCATE 1,1,1
  36. 310 PRINT:PRINT "NUMBER EDIT"
  37. 320 GOSUB 1500
  38. 330 K$="":PRINT "Do you wish to:  1) Enter numbers
  39. 340                 PRINT "                 2) Delete entries
  40. 350                 PRINT "                 3) Insert blank entries
  41. 360                 PRINT "                 4) Clear memory
  42. 370                 PRINT "                 5) List numbers
  43. 380 J$=INKEY$:J=VAL(J$):IF J$=CHR$(27) THEN CLS:GOTO 190
  44. 390 IF J=5 THEN GOSUB 420:GOTO 330
  45. 400 IF J=4 THEN 730
  46. 410 IF J<1 OR J>3 THEN 380:ELSE CLS:GOSUB 1500:GOSUB 1510:RE=1:ON J GOTO 430,760,580
  47. 420 CLS:GOSUB 1500:GOSUB 880:RETURN
  48. 430 PRINT:PRINT "Start at entry number?(L=list) :";:GOSUB 1520:PRINT
  49. 440 IF K$="l" OR K$="L" THEN CLS:GOSUB 1500:GOSUB 1510:GOSUB 880:GOTO 430
  50. 450 K=VAL(K$):IF K<1  OR K>100 THEN K=1:ELSE FE=K-1
  51. 460 PRINT "ENTRY NUMBER :"FE+1
  52. 470 IF FE>EF THEN EF=FE
  53. 480 PRINT "NAME : ";:COLOR 0,7:K$="":GOSUB 1520:IF K$="" THEN PRINT A$(FE+1);:GOTO 500
  54. 490 A$(FE+1)=K$
  55. 500 COLOR 7,0:PRINT
  56. 510 PRINT "NUMBER : ";:COLOR 0,7:K$="":GOSUB 1520:FE=FE+1:IF K$<>"" THEN NUM$(FE)=K$ ELSE PRINT NUM$(FE);
  57. 520 COLOR 7,0:PRINT
  58. 530 IF VAL(NUM$(FE))= 0 THEN PRINT "BAD NUMBER FORMAT":FE=FE-1:GOTO 510
  59. 540 PRINT:PRINT "Is this all correct ?";:LOCATE ,,1
  60. 550 Z$=INKEY$:IF Z$="" THEN 550
  61. 560 PRINT Z$ :IF Z$="n" OR Z$="N" THEN FE=FE-1
  62. 570 GOTO 460
  63. 580 PRINT"INSERT":
  64. 590 K$="":PRINT:PRINT"After which entry do you wish to insert additional entries?(L=list)";:GOSUB 1520:PRINT
  65. 600 IF K$="l" OR K$="L" THEN CLS:GOSUB 1500:GOSUB 1510:GOSUB 880:GOTO 590
  66. 610 K=VAL(K$):IF K>EF OR K<1 THEN PRINT "Entry does not exist.":GOTO 590
  67. 620 EN=K
  68. 630 K$="":PRINT:PRINT"How many lines should be inserted?";:GOSUB 1520:PRINT
  69. 640 K=VAL(K$):IF K<1 THEN 630
  70. 650 IF EF+K>100 THEN PRINT "Not enough room for"K"lines.":GOTO 630
  71. 660 LN=K
  72. 670 FOR Z=EF TO EN STEP -1:A$(Z+LN)=A$(Z):NUM$(Z+LN)=NUM$(Z):NEXT
  73. 680 FOR Z=EN+1 TO EN+LN:A$(Z)="":NUM$(Z)="":NEXT
  74. 690 EF=EF+LN:PRINT :PRINT LN;"ENTRIES INSERTED."
  75. 700 PRINT" Press any key to return to edit menu."
  76. 710 J$=INKEY$:IF J$="" THEN 710
  77. 720 IF J$=CHR$(27) THEN  210: ELSE GOTO 300
  78. 730 '*** CLEAR MEMORY ***
  79. 740 FOR X=1 TO EF:A$(X)="":NUM$(X)="":NEXT:PRINT "Memory Cleared.":PRINT:GOTO 330
  80. 750 '*** DELETE ENTRIES ***
  81. 760 PRINT"DELETE"
  82. 770 PRINT:PRINT "Delete which entry?(L=list)";:GOSUB 1520:PRINT:K=VAL(K$)
  83. 780 IF K$="l"  OR K$="L" THEN CLS:GOSUB 1500:GOSUB 1510:GOSUB 880:GOTO 770
  84. 790 IF K<1 OR K>EF THEN PRINT "ENTRY DOES NOT EXIST.":PRINT:GOTO 770
  85. 800 FOR X=K+1 TO ER:NUM$(X-1)=NUM$(X):A$(X-1)=A$(X):NEXT X:A$(ER)="":NUM$(ER)="":EF=EF=1:PRINT "Entry"K"Deleted.":GOTO 770
  86. 810 REM *** NUMBER LISTING ***
  87. 820 ON ERROR GOTO 1000
  88. 830 CLS: PRINT "Do you wish a hard copy of the following list ?";:LOCATE ,,1
  89. 840 Z$=INKEY$:IF Z$="" THEN 840
  90. 850 IF Z$=CHR$(27) THEN CLS:GOTO 190
  91. 860 IF Z$="y" OR Z$="Y" THEN PR=1:PRINT"Turn your printer on.":LPRINT:ELSE PR=0
  92. 870 CLS:GOSUB 880:GOTO 190
  93. 880 PRINT "PHONE DIRECTORY:
  94. 890 PRINT "ENTRY         NAME                     NUMBER"
  95. 900 IF PR=1 THEN LPRINT "ENTRY         NAME                     NUMBER"
  96. 910 FOR Y=1 TO 78:PRINT "-";:IF PR=1 THEN LPRINT "-";
  97. 920 NEXT Y :PRINT:IF PR=1 THEN LPRINT
  98. 930 FOR X=1 TO EF
  99. 940 IF NUM$(X)="" THEN 970
  100. 950 PRINT X,LEFT$(A$(X),15);:LOCATE ,40:PRINT NUM$(X)
  101. 960 IF PR=1 THEN LPRINT X,LEFT$(A$(X),15);SPC(25-LEN(A$(X)));NUM$(X)
  102. 970 NEXT X
  103. 980 PRINT:PRINT"Hit any key to continue :";:LOCATE,,1
  104. 990 J$=INKEY$:IF J$="" THEN 990:ELSE PRINT:RETURN
  105. 1000 IF ERR=27 THEN PRINT "TURN PRINTER ON!!!":RESUME
  106. 1010 PRINT "ERROR #"ERR:RESUME
  107. 1020 REM *** DIALING SEQUENCE ***
  108. 1030 ON ERROR GOTO 1630
  109. 1040 GOSUB 1500
  110. 1050 PRINT "WHICH ENTRY DO YOU WISH TO DIAL?(L=LIST)";:LOCATE,,1
  111. 1060 K$="":GOSUB 1520:J=VAL(K$):IF K$="L" OR K$="l" THEN CLS:GOSUB 1500:GOSUB 880:GOTO 1050
  112. 1070 IF J<1 OR J>EF THEN PRINT "THERE IS NO SUCH NUMBER.":PRINT:GOTO 1050
  113. 1080 IF NUM$(J)="" THEN PRINT "THERE IS NO SUCH NUMBER.":PRINT :GOTO 1050
  114. 1090 PRINT :PRINT"DO YOU WISH TO CALL ";CHR$(34);A$(J);CHR$(34);" ?";
  115. 1100 LOCATE ,,1
  116. 1110 J$=INKEY$:IF J$="" THEN 1110
  117. 1120 PRINT J$
  118. 1130 IF J$="n" OR J$="N" THEN 1050
  119. 1140 IF J$=CHR$(27) THEN CLS: GOTO  210
  120. 1150 REM *** CONNECT MODEM ***
  121. 1160 OPEN "COM1:" AS #1
  122. 1170 PRINT #1,"ATDT";NUM$(J)
  123. 1180 PRINT NUM$(J)
  124. 1190 FOR X=1 TO 2000:NEXT:CLOSE:CLS:GOTO 190
  125. 1200 REM *** DATA STORAGE ***
  126. 1210 ON ERROR GOTO 1300
  127. 1220 CLS:GOSUB 1500:PRINT:PRINT "Directory Storage":PRINT :PRINT:PRINT "Directories on file:"
  128. 1230 FILES "*.dir":PRINT:PRINT:PRINT "Name of directory to be saved? ";:GOSUB 1520
  129. 1240 IF K$="" THEN CLS  :GOTO 190
  130. 1250 K$= LEFT$(K$,8)+".DIR": OPEN K$ FOR OUTPUT AS #2
  131. 1260 FOR X=1 TO EF:IF NUM$(X)="" THEN 1280
  132. 1270 WRITE #2,LEFT$(A$(X),15):WRITE #2, NUM$(X)
  133. 1280 NEXT  X
  134. 1290 CLOSE:PRINT:PRINT "The following directory was saved:":GOSUB 890:CLS:GOTO 190
  135. 1300 IF ERR=53 THEN PRINT "[none]":RESUME NEXT
  136. 1310 PRINT "Error #";ERR:RESUME
  137. 1320 REM *** DATA LOAD ***
  138. 1330 ON ERROR GOTO 1470
  139. 1340 CLS:GOSUB 1500:PRINT:PRINT "Directory Load":PRINT:PRINT:PRINT "Directories on file:"
  140. 1350 FILES "*.dir":PRINT:PRINT:PRINT "Name of directory to be loaded? ";:GOSUB 1520
  141. 1360 IF K$="" THEN CLS  :GOTO 190
  142. 1370 K$= LEFT$(K$,8)+".DIR": OPEN K$ FOR INPUT AS #2
  143. 1380 PRINT:PRINT"Clear all previous numbers?";
  144. 1390 K$=INKEY$:IF K$="" THEN 1390:ELSE PRINT K$:IF K$<>"Y" AND K$<>"y" THEN 1410
  145. 1400 FOR X=1 TO 100:A$(X)="":NUM$(X)="":NEXT:PRINT"MEMORY CLEARED.":EF=0
  146. 1410 FE=0
  147. 1420 FE=FE+1:IF FE>100 THEN PRINT "Out of Room":ERROR 62
  148. 1430 IF NUM$(FE)<>"" THEN 1420
  149. 1440 INPUT #2,A$(FE),NUM$(FE)
  150. 1450 IF FE>EF THEN EF=FE
  151. 1460 GOTO 1430
  152. 1470 IF ERR=62 THEN PRINT "NUMBERS LOADED.":PRINT:CLOSE #2:FE=FE-1:RESUME 190
  153. 1480 IF ERR=53 THEN RESUME 1320
  154. 1490 PRINT "ERROR #"ERR:RESUME
  155. 1500 C=CSRLIN:LOCATE 25,35:PRINT "Type <esc> to return to menu.";:LOCATE C,1,1:RETURN
  156. 1510 C=CSRLIN:LOCATE 25,35:PRINT "Type '\' to return to edit menu.";:LOCATE C,1,1:RETURN
  157. 1520 REM *** key entry sequence ***
  158. 1530 K$=""
  159. 1540 LOCATE ,,1
  160. 1550 J$=INKEY$:IF J$="" THEN 1550
  161. 1560 IF J$=CHR$(27) THEN COLOR 7:RE=0:CLS:GOTO 190
  162. 1570 IF RE=1 AND J$=CHR$(92) THEN COLOR 7:CLS:GOTO 300
  163. 1580 IF J$<>CHR$(8) THEN 1610
  164. 1590 IF K$="" THEN 1550 ELSE LOCATE ,POS(0)-1:PRINT " ";
  165. 1600 LOCATE ,POS(0)-1:K$=LEFT$(K$,LEN(K$)-1):GOTO 1550
  166. 1610 IF J$=CHR$(13) THEN PRINT " ";:LOCATE ,,0:RETURN
  167. 1620 K$=K$+J$:PRINT J$;:GOTO 1540
  168. 1630 PRINT "TURN MODEM ON ! ":RESUME
  169.